#lang racket


(require "../backends/main.rkt")
(require "../base/main.rkt")

(provide (struct-out rhino-shape)
         
         singleton-shape?
         singleton-id
         
         list<-shape
         join-shapes
         
         shape<-vector<string>
         vector<string><-shape
         vector<string><-list<shape>)


(define-struct (rhino-shape shape)
  (ids))


(define (singleton-shape? shape)
  (and
   (shape? shape)
   (or
    (not (list? (rhino-shape-ids shape)))
    (singleton? (rhino-shape-ids shape)))))

(define (singleton-id shape)
  (if (list? (rhino-shape-ids shape))
      (first (rhino-shape-ids shape))
      (rhino-shape-ids shape)))


(define (list<-shape shape)
  (let ((ids (rhino-shape-ids shape)))
    (if (list? ids)
        ids
        (list ids))))

(define (join-shapes shape1 shape2)
  (make-rhino-shape
   (append
    (list<-shape shape1)
    (list<-shape shape2))))


(define (shape<-vector<string> ids)
  (make-rhino-shape (vector->list ids)))

(define (vector<string><-shape shape)
  (let ((ids (rhino-shape-ids shape)))
    (if (list? ids)
        (list->vector ids)
        (vector ids))))

(define (vector<string><-list<shape> shapes)
  (apply vector-append (map vector<string><-shape shapes)))